.TITLE	DRSUB
	.IDENT	/03.41/
;+
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
; B. S. MCCARTHY
;
; PREVIOUSLY MODIFIED BY:
;
;	S. C. ADAMS
;	J. W. BERZLE
;	M. S. FOX
;	J.    GEMIGNANI, JR.
;	R. D. HANEY
;	J. R. KAUFFMAN
;	J. M. LAWLER
;	T.    LEKAS
;	T. M. MARTIN
;	B. S. MCCARTHY
;	L. B. MCCULLEY
;	K. L. NOEL
;	D. P. RABAHY
;	P. K. M. WEISS
;	D.    CARROLL
;
; MODIFIED FOR RSX-11M-PLUS V4.6 BY:
;
;	D. Carroll	18-Oct-1995	03.41
;		DC404  - Include PSECT statement to allow ICB pool to be
;			 expanded during sysgen
;

	.IF DF	S$$HDW

	.MCALL	SHDDF$,PKTDF$
	SHDDF$			;DEFINE SHADOW RECORDING OFFSETS

	.ENDC			;S$$HDW



	.IF DF	P$$LAS

	.MCALL	HDRDF$,PCBDF$,TCBDF$,WDBDF$
	HDRDF$			;DEFINE HEADER AND WINDOW BLOCK OFFSETS
	PCBDF$			;DEFINE PCB AND ATTACHMENT DESCR OFFSETS
	TCBDF$			;DEFINE TCB OFFSETS
	WDBDF$			;DEFINE WDB OFFSETS



;	THE FOLLOWING TABLE OF VALUES MUST BE IDENTICAL TO THE ONE AT THE
;	BEGINNING OF THE KX DRIVER.

	.IF DF C$$RMT		;IF REMOTE SYSTEM SERVICES

	.ASECT

	.=120000

CPRCON:	.BLKW	1		;UNIT CONNECT ENTRY POINT
CPRALO:	.BLKW	1		;ALLOCATE BUFFER SPACE AND COMMAND RING
CPRDEA:	.BLKW	1		;DEALLOCATE BUFFER SPACE
CPRSEN:	.BLKW	1		;SEND PACKET TO VMS
CPRABO:	.BLKW	1		;ABORT TASK AND CLEANUP CPRSX PACKETS
CPRRCV:	.BLKW	1		;RE-ENTER DRIVER WHEN POOL HAS BECOME AVAILABLE

	.PSECT

	.ENDC			;C$$RMT

	.IIF	DF,K$$DAS&I$$CBP,	.PSECT	EXEC1				;DC404
										;DC404
	.PAGE
;+
; **-$DRDSE-DECLARE SIGNIFICANT EVENT
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO DECLARE A SIGNIFICANT EVENT.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(35.),DPB SIZE(1.).
;
; INPUTS:
;
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LAST WORD IN THE DPB+2.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 WITH A DIRECTIVE STATUS OF +1.
;
;	NOTE: THIS DIRECTIVE IS ALSO CALLED A SUBROUTINE
;-



	.IF NDF	M$$PRO

$DRDSE::MOV	$ACTHD,@$RQSCH	;SET DISPATCH TO FRONT OF LIST

	.IFF

$DRDSE::MOV	R0,-(SP)	;SAVE R0
	MOV	#$RQTAB,R0	;POINT TO RESCHEDULE TABLE
15$:	MOV	$ACTHD,(R0)+	;SET DISPATCH TO FRONT OF LIST
	CMP	R0,#$RQTAB+<M$$PRO*2> ;AT END OF TABLE?
	BLO	15$		;IF LO NO

;
; WE HAVE JUST CHANGED THE RESCHEDULE POINTERS FOR ALL PROCESSORS.
; WE SHOULD INTERRUPT ALL OF THEM.
;

	MOV	$URMST,R0	;GET ONLINE BUS RUNS
	BIC	$CPMSK,R0	;ONLY PROCESSORS NOW
	BIC	$CPBIT,R0	;NOT US EITHER
	BEQ	25$		;IF EQ NOBODY TO INTERRUPT
	MTPS	#PR7		;INHIBIT DEADLOCKS
	LOCK$	$FORKL,SPIN
	BIS	R0,$IIPND	;SHOW WORK IS WAITING
	ULOCK$	$FORKL,SPIN
	MTPS	#0
25$:	MOV	(SP)+,R0	;RESTORE R0

	.ENDC


	CLR	$SIGFL		;CLEAR TASK WAITING FOR SIGNIFICANT EVENT
	RETURN			;RETURN DIRECTIVE STATUS  OF +1

;+
; **-$DFWFS-WAITFOR SINGLE EVENT FLAG
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO SUSPEND THE EXECUTION OF THE
; ISSUING TASK UNTIL A SPECIFIED EVENT FLAG IS SET.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(41.),DPB SIZE(2.).
;	WD. 01 -- EVENT FLAG NUMBER OF FLAG TO WAITFOR.
;
; INPUTS:
;
;	R0=EVENT FLAG MASK WORD.
;	R1=EVENT FLAG MASK ADDRESS.
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LAST WORD IN THE DPB+2.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 WITH A DIRECTIVE STATUS OF +1.
;-

$DRWFS::BIC	#1,R1		;CLR GRP GLOBAL 2ND WORD INDCATOR
$DRWS1::BIS	#T2.WFR,T.ST2(R5) ;PUT TASK IN WAITFOR STATE
				;(DO NOT USE R2 BECAUSE OF QIOW CALL)
	MOV	R0,T.EFLM(R5)	;SET WAITFOR MASK
	MOV	R1,T.EFLM+2(R5)	;SET WAITFOR MASK ADDRESS
	CALLR	$SETRT		;SET A SCHEDULE REQUEST


;+
; **-$DRCSR-CANCEL SCHEDULE REQUESTS
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO CANCEL ALL SCHEDULE REQUESTS FOR A
; SPECIFIED TASK.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(25.),DPB SIZE(3.).
;	WD. 01 -- FIRST HALF OF TASK NAME.
;	WD. 02 -- SECOND HALF OF TASK NAME.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TCB TO CANCEL SCHEDULE REQUESTS FOR.
;	R1=ADDRESS OF THE TASK STATUS WORD OF THE TASK TO CANCEL SCHEDULE REQUES
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LAST WORD IN THE DPB+2.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 WITH A DIRECTIVE STATUS OF +1.
;-


$DRCS1::			;REF LABEL FOR ERROR LOGGER

$DRCSR::MOV	R0,R5		;SET TCB ADDRESS
	CLR	R4		;SET INITIAL ENTRY TYPE MINUS 2
	CALL	(PC)		;REMOVE PERIODIC/SINGLE SHOT REQUESTS
	TST	(R4)+		;ADVANCE TO NEXT ENTRY TYPE
	CALLR	$CLRMV		;REMOVE ALL REMAINING ENTRIES

;+
; **-$DRGMX-GET MAPPING CONTEXT
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO RETURN THE MAPPING CONTEXT OF
; THE TASK, I.E. TO FILL IN UP TO N WINDOW DEFINITION BLOCKS,
; WHERE N IS THE TOTAL NUMBER OF WINDOW BLOCKS IN THE TASK HEADER.
; NO INFORMATION IS RETURNED ON UNUSED WINDOW BLOCKS.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(113.),DPB SIZE(2.)
;	WD. 01 -- ADDRESS OF THE N WINDOW DEFINITION BLOCKS
;
; INPUTS:
;
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	(R3)=ADDRESS OF N WINDOW DEFINITION BLOCKS
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
;	INPUT FIELDS IN THE WINDOW DEFINITION BLOCKS ARE:
;		NONE.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS98' IS RETURNED IF THE ADDRESS
;			CHECK OF THE N WINDOW BLOCKS PLUS TERMINATOR WORD
;			FAILS.
;
;	OUTPUT FIELDS IN EACH WINDOW DEFINITION BLOCK ARE:
;		W.NID=ADDRESS WINDOW ID OF NEXT ESTABLISHED ADDRESS WINDOW.
;		W.NAPR=BASE APR OF THE WINDOW.
;		W.NBAS=VIRTUAL BASE ADDRESS OF THE WINDOW.
;		W.NSIZ=SIZE OF THE ADDRESS WINDOW.
;		W.NRID=REGION ID IF MAPPED OR UNMODIFIED.
;		W.NOFF=OFFSET IN REGION IF MAPPED OR UNMODIFIED.
;		W.NLEN=LENGTH OF MAP IF MAPPED OR UNMODIFIED.
;		W.NSTS=NECESSARY BITS TO RESTORE WINDOW.
;			WS.SIS=1 IF WINDOW IS IN SUPERVISOR I SPACE.
;			WS.MAP=1 IF WINDOW IS MAPPED.
;			WS.WRT=1 IF WINDOW IS MAPPED WITH WRITE ACCESS.
;
;	NOTE:	ON SYSTEMS SUPPORTING NON RESIDENT TASK HEADERS, THE
;		DIRECTIVE DISPATCHER MAPS THE NON RESIDENT HEADER
;		THROUGH APR6. ON THESE SYSTEMS WE WILL USE APR5 TO
;		MAP TO THE USER TASK (N WINDOW DEFINITION BLOCKS).
;		THEREFORE, THIS DIRECTIVE CAN NOT GO INTO A DIRECTIVE
;		PARTITION WITHOUT SOME MODIFICATIONS.
;
;		WHEN MAPPING TO A TASK REGION, W.BOFF IS OFFSET BY
;		THE SIZE OF THE EXTERNAL TASK HEADER.  WE WILL ADJUST
;		THAT VALUE HERE SO THAT THE TASK DOES NOT KNOW WHETHER
;		OR NOT IT HAS AN EXTERNAL HEADER.
;-

$DRGMX::MOV	H.WND(R4),R4	;POINT TO NUMBER OF WINDOW BLOCKS IN HEADER
	MOV	(R4)+,R1	;PICK UP NUMBER OF WINDOW BLOCKS
	MOV	R1,-(SP)	;SAVE NUMBER OF WINDOW BLOCKS
	ASL	R1		;CONVERT TO BYTES TO ADDRESS CHECK
	ASL	R1		;
	ASL	R1		;
	INC	R1		;(INCLUDE WORD FOR TERMINATOR)
	ASL	R1		;
	MOV	(R3),R3		;PICK UP VIRTUAL ADDRESS OF WINDOW BLOCKS

	.IF DF	X$$HDR

	MOV	R3,R0		;GET VA TO ADDRESS CHECK
	CALL	$ACHCK		;ADDRESS CHECK
	BCS	50$		;IF CS, ADDRESS CHECK FAILURE
	CALL	$RELOC		;RELOCATE TO KERNEL ADDRESS
	MOV	R1,KISAR5	;MAP USER BUFFER
	MOV	R2,R3		;GET KERNEL VIRTUAL ADDRESS
	SUB	#20000,R3	;AND MAKE IT AN APR5 ADDRESS

	.IFF	; DF X$$HDR

	CALL	$ACHKP		;ADDRESS CHECK AND MAP TO WINDOW BLOCKS

	.ENDC	; DF X$$HDR


	CLR	-(SP)		;INITIALIZE WINDOW ID COUNTER
10$:	TST	W.BSIZ(R4)	;IS NEXT BLOCK AN ESTABLISHED WINDOW?
	BNE	11$		;IF NE YES
	ADD	#W.BLGH,R4	;POINT TO NEXT WINDOW BLOCK
	BR	40$		;BRANCH TO DETERMINE IF MORE BLOCKS
11$:	MOVB	(SP),(R3)+	;SET WINDOW ID (W.NID)
	MOV	(R4)+,-(SP)	;SAVE PCB ADDRESS (W.BPCB)
	MOV	(R4)+,R1	;PICK UP LOW VIRTUAL ADDRESS (W.BLVR)
	MOVB	-1(R4),(R3)	;GET ITS HIGH BYTE (W.BLVR+1)(W.NAPR)
	ASLB	(R3)		;SHIFT TO FORM APR NUMBER (W.NAPR)
	ROLB	(R3)		;
	ROLB	(R3)		;
	ROLB	(R3)+		;
	MOV	R1,(R3)+	;SET VIRTUAL BASE ADDRESS (W.NBAS)
	MOV	(R4)+,R2	;PICK UP HIGH VIRTUAL ADDRESS (W.BHVR)
	MOV	(R4)+,R0	;PICK ATT DESCRIPTOR ADDRESS (W.BATT)
	MOV	(R4)+,(R3)+	;SET WINDOW SIZE (W.BSIZ)(W.NSIZ)

	.IF DF	X$$HDR

	MOV	(SP)+,R2	;GET PCB ADDRESS FOR THIS WINDOW

	.IFF	; DF X$$HDR

	TST	(SP)+		;IS THIS WINDOW MAPPED?

	.ENDC	;DF X$$HDR

	BEQ	20$		;IF EQ NO
	MOV	R0,(R3)+	;SET REGION ID (W.NRID)
	MOV	T.ATT(R5),-(SP)	;PUSH ADDRESS OF FIRST ATTACHMENT DESCRIPTOR
	SUB	#A.TCBL,(SP)	;POINT TO FIRST WORD
	CMP	R0,(SP)+	;TASK REGION?
	BNE	15$		;IF NE NO
	CLR	-2(R3)		;SET IT TO DEFAULT TO TASK REGION (W.NRID)

	.IF DF	X$$HDR

15$:	MOV	(R4)+,(R3)	;SET OFFSET W.BOFF TO W.NOFF
	MOVB	P.HDLN(R2),R2	;GET SIZE OF XTRNL HEADER (IF ANY)
	SUB	R2,(R3)+	;ADJUST OFFSET BY HEADER LENGTH
	MOV	W.BHVR-W.BFPD(R4),R2 ;RESTORE HIGH VA (W.BHVR)

	.IFF 	; DF X$$HDR

15$:	MOV	(R4)+,(R3)+	;SET OFFSET (W.BOFF)(W.NOFF)

	.ENDC	; DF X$$HDR

	SUB	R1,R2		;CALCULATE LENGTH
	ADD	#1,R2		;
	ROL	R2		;CONVERT TO 32W BLOCKS
	ROL	R2		;
	ROLB	R2		;
	SWAB	R2		;
	MOV	R2,(R3)+	;SET THE LENGTH (W.NLEN)
	TST	(R4)+		;ADVANCE TO LAST PDR IMAGE (W.BFPD)
	MOV	(R4)+,(R3)	;PICK UP LAST PDR IMAGE (W.BLPD)(W.NSTS)
	BIC	#^C4,(R3)	;CLEAR ALL BUT WRITE ACCESS BIT (W.NSTS)
	ASR	(R3)		;SHIFT INTO PLACE (W.NSTS)


	.IF DF	U$$DAS

	BITB	#20,W.BFPD-W.BLGH(R4) ;USER D SPACE WINDOW ?
	BEQ	18$		;IF EQ NO
	BIS	#WS.UDS,(R3)	;SET USER D SPACE BIT (W.NSTS)
	BR	19$		;SKIP SUPER I CHECK
18$:				;REFERENCE LABEL

	.ENDC	; DF U$$DAS


	.IF DF S$$LIB

	TSTB	W.BFPD-W.BLGH(R4) ;SUPERVISOR I SPACE WINDOW?
	BMI	19$		;IF MI NO
	BIS	#WS.SIS,(R3)	;SET SUPERVISOR I SPACE BIT (W.NSTS)

	.ENDC


19$:	BIS	#WS.MAP,(R3)+	;INDICATE WINDOW IS MAPPED (W.NSTS)
	BR	30$		;
20$:	ADD	#W.NSTS-W.NRID,R3 ;POINT TO NEXT WINDOW ID BLOCK
	ADD	#W.BLGH-W.BOFF,R4 ;POINT TO NEXT WINDOW BLOCK
	CLR	(R3)+		;CLEAR STATUS WORD
30$:	TST	(R3)+		;SKIP OVER SEND/RECEIVE BUFFER ADDRESS (W.NSRB)
40$:	INC	(SP)		;BUMP WINDOW ID
	CMP	(SP),2(SP)	;DONE YET?
	BLO	10$		;IF LO NO
	MOV	(SP)+,(R3)	;STORE NUMBER OF HEADER SLOTS AS TERMINATOR
	NEG	(R3)		;AND NEGATE
	TST	(SP)+		;CLEAN STACK

	.IF NDF K$$DAS

	MOV	$DRAPR,KINAR5	;REMAP DISPATCHER IN I-SPACE

	.ENDC	; NDF K$$DAS

	RETURN			;

	.IF DF	X$$HDR

50$:	DRSTS	D.RS98		;BAD ADDRESS

	.ENDC	; DF X$$HDR

	.ENDC	; DF P$$LAS

;+
; **-$DRQRQ-QUEUE I/O REQUEST
;
; THIS ROUTINE IS CALLED TO OPTIONALLY INSERT AN I/O PACKET INTO
; A CONTROLLER QUEUE AND TO CALL THE DRIVER TO INITIATE
; ACTIVITY ON THE DEVICE.
;
; IF THE DEVICE SUPPORTS SEEK OPTIMIZATION AND THE PACKET IS FOR
; A LOGICAL TRANSFER FUNCTION, THE LBN FOR THE REQUEST IS
; BLOCK CHECKED AND CONVERTED TO THE SECTOR/TRACK/CYLINDER FORM.
; THE BLOCK CHECK ROUTINE IS IN THE CORRESPONDING DRIVER.
;
; INPUTS:
;
;	R1=ADDRESS OF THE I/O PACKET.
;	R5=ADDRESS OF THE UNIT CONTROL BLOCK.
;
; OUTPUTS:
;
;	IF NO I/O PACKET IS SPECIFIED AS INPUT (R1 = 0) THE
;	DRIVER IS SIMPLY CALLED TO INITIATE ACTIVITY ON THE
;	DEVICE.  THIS OPTION ALLOWS US TO RE-INITIATE
;	ACTIVITY ON A DEVICE WHEN IT HAS SATISFIED A
;	STALLED I/O STATE.
;
;	IF AN I/O PACKET IS SPECIFIED AS INPUT, IT IS PLACED
;	IN THE CONTROLLER QUEUE AND ACTIVITY IS INITIATED
;	ON THE DEVICE.
;
;	NOTE: R4 IS DESTROYED BY THIS ROUTINE.
;-

$DRQRQ::			;REFERENCE LABEL

	MOV	U.SCB(R5),R4	;GET ADDRESS OF STATUS CONTROL BLOCK

	MOV	(R5),R2		;GET ADDRESS OF THE DCB
	MOV	KINAR5,-(SP)	;SAVE KERNEL INSTRUCTION APR5


	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE KERNEL DATA APR5

	.IFTF	;K$$DAS

	.IF DF	D$$CHE		;DISK DATA CACHING SUPPORT

	TST	R1		;I/O REQUEST?
	BEQ	10$		;NO, CAN'T CACHE NOTHING

	CMP	KINAR5,$DRCHE	;REQUEST FROM CACHE? (CHECK KINAR5 MAPPING)
	BEQ	10$		;YES IF EQ; CACHE ALWAYS BYPASSES CACHE

	BIT	#DV.MSD,U.CW1(R5) ;POSSIBLY A DISK DEVICE?
	BEQ	10$		;NO IF EQ; DON'T BOTHER CACHER
	BIT	#DV.SQD,U.CW1(R5) ;IS THIS POSSIBLE DISK REALLY A TAPE?
	BNE	10$		;YES IF NE; DON'T CACHE THESE EITHER

	MOV	$DRCHE,KINAR5	;MAP CACHER [DIRECTIVE] PARTITION
	BEQ	10$		;IF EQ NOT PRESENT IN RUNNING EXECUTIVE

	MOV	R2,-(SP)	;SAVE REGISTER ACROSS CALL
	CALL	@#120000	;HOPE THIS CACHE CALL IS WORTH IT
	MOV	(SP)+,R2	;RESTORE DCB ADDRESS

; RETURNS FROM CACHER:
;	R1 -> I/O PACKET = FORWARD REQUEST TO DRIVER, NO CACHE PROCESSING
;	R1 = 0		CACHER ACCEPTED REQUEST, DON'T FORWARD TO DRIVER

	TST	R1		; DID CACHER CATCH IT?
	.IF DF	S$$HDW
	BNE	10$		; CACHE DIDN'T HANDLE IT, CALL DRIVER

	JMP	$QOPDN		; FINISH THE I/O, NOTHING IS LEFT

	.IFF	;DF S$$HDW
	BEQ	$QOPDN		; CACHE HANDLED IT, DON'T CALL DRIVER

	.ENDC	;DF S$$HDW

10$:
	.ENDC			;D$$CHE

	MOV	D.PCB(R2),R3	;GET DRIVER PCB ADDRESS
	BEQ	20$		;IF EQ DRIVER IS PART OF EXEC
	MOV	P.REL(R3),KINAR5 ;MAP KERNEL INSTRUCTION APR5 TO DRIVER

	.IFT	;K$$DAS

	MOV	P.REL(R3),KDSAR5 ;MAP KERNEL DATA APR5 TO DRIVER

	.IFTF	;K$$DAS

20$:	TST	R1		;I/O PACKET TO QUEUE ?

	.IF DF	S$$HDW
	.IFF	;DF,S$$HDW
	BEQ	40$		;IF EQ, NO - SIMPLY CALL DRIVER
	.IFT	;DF,S$$HDW
	BNE	21$		; if NE, process the I/O request

	JMP	40$		; Simply call the driver

;
; COPY THE I/O PACKET FOR SHADOWING
;
21$:	MOV	R4,-(SP)	;SAVE THE SCB ADDRESS
	MOV	R1,R3		;COPY THE I/O PACKET ADDRESS FOR $SHFND
	CALL	$SHFND		;THIS DEVICE SHADOWED?
	BCS	35$		;IF CS NO, DON'T COPY
	.IF	DF,S$$HLS	; shadow load sharing?
	TSTB	ML.DNC(R4)	; Has another part completed?
	BNE	35$		; Yes, don't copy it ...
	.ENDC	;DF,S$$HLS
	CMP	ML.PRI(R4),R1	;IS THIS THE PRIMARY PACKET?
	BNE	35$		;IF NE NO, DON'T COPY
	MOV	#I.LGTH/2,R0	;GET THE NUMBER OF WORDS IN THE PACKET
32$:	MOV	(R1)+,(R2)+	;COPY THE NEXT WORD IN THE PACKET
	SOB	R0,32$		;LOOP FOR REST OF PACKET
	SUB	#I.LGTH,R1	;GET THE PRIMARY I/O PACKET ADDRESS
	MOV	U.UMB(R5),R0	;GET THE UMB POINTER
	MOV	M.UCBS+2(R0),I.UCB-I.LGTH(R2)  ;COPY THE UCB POINTER INTO
						;THE SECONDARY PACKET
35$:	MOV	(SP)+,R4	;RESTORE THE SCB
	MOV	(R5),R2		;GET ADDRESS OF THE DCB

	.ENDC			;S$$HDW


	.IF	DF,S$$HDW&S$$HLS
	CLR	(R1)		; clear flag for LBN translated
;+
;   Implement shadowed device load sharing, to lower the I/O requests
; to the shadow primary, and also to allow overlapped seeks to be started
; while a data transfer is assumed in progress ...
;
;   The general algorithm of this section is;
;
;	Determine if either SCB is busy, and other SCB idle. If so,
; select the idle SCB.
;
;	If both SCB's are busy/idle, determine if one of the units are idle.
; If so, select the idle unit.
;
;	If both units are both busy or idle, and the devices support
; seek optimization, convert the packet LBN, and determine which device
; is nearest to the I/O request.
;
;	If the difference between the current and desired cylinders are
; the same between both devices, or if seek optimization is not supported
; on both units, then the selection is made by alternating between the
; primary and secondary units.
;
;	For special cases such as error recovery, no optimization is made,
; and the request goes to the device specified.
;
;-
	CMPB	I.FCN+1(R1),#IO.RLB/256.	; is this a read request?
	BEQ	351$		; if EQ, yes, continue the process

	CALLR	360$		; branch aid ...

351$:	MOV	R1,R3		; Copy the I/O packet address for $SHFND
	CALL	$SHFND		; Is this device shadowed?
	BCS	3515$		; If CS no, no sharing possible ...

	TSTB	ML.DNC(R4)	; are we attempting recovery?
	BNE	3515$		; yes, don't optimize ...

	MOV	R5,-(SP)	; save R5 for $CKLBN ...
	MOV	U.UMB(R5),R5	; and extract the target UMB address
	CALL	$CKLBN		; check if LBN is legal on both devices
				; this will also handle IO.SCF functions
	MOV	(SP)+,R5	; restore our UCB address
	BCC	3517$		; if CC, LBN is valid, check load share

3515$:	CALLR	359$		; branch aid ...

3517$:	MOV	U.UMB(R5),R4	; get the UMB address
	MOVB	M.STS(R4),R4	; get the UMB status byte

	BITB	#MS.DSC,R4	; is the secondary disabled?
	BNE	3515$		; if NE, yes, queue to the primary device

	ASSUME	MS.LDS,200	; sign bit assumed
	TSTB	R4		; is sharing enabled?
	BPL	3515$		; if PL, no, don't share ...

	BITB	#MS.ACP,R4	; are ACP requests forced to primary?
	BEQ	352$		; if EQ, no, use standard algorithm

	CMP	I.TCB(R1),U.ACP(R5)	; is this the devices ACP task?
	BEQ	3515$		; if EQ, yes, pass to the primary
;+
;   Determine which SCB is not busy ...
;-
352$:	MOV	I.UCB(R2),R3	; get the secondary device UCB address
	MOV	U.SCB(R3),R0	; and the secondary device SCB

	BITB	#MS.DPR,R4	; is the primary device disabled?
	BNE	357$		; if NE, yes, use the secondary device

	MOV	U.SCB(R5),R4	; restore the primary SCB address
	CMP	R0,R4		; are both devices on the same SCB
	BEQ	355$		; if EQ, yes, status is identical

	TSTB	S.STS(R4)	; primary device busy?
	BEQ	353$		; if EQ, nope ...

	TSTB	S.STS(R0)	; secondary device busy?
	BEQ	357$		; if EQ, nope, use secondary UCB
	BR	355$		; check unit status ...

353$:	TSTB	S.STS(R0)	; secondary device busy?
	BNE	3515$		; if NE, yes, use primary device

;+
;   Determine which UCB is not busy ...
;-
355$:	TSTB	U.STS(R5)	; is the primary busy?
	BPL	3552$		; if PL, nope, not busy ...

	TSTB	U.STS(R3)	; is the secondary busy?
	BPL	357$		; if PL, nope, use secondary
	BR	3555$		; check cylinders

3552$:	TSTB	U.STS(R3)	; is the secondary busy?
	BMI	3515$		; if MI, yes, use primary

;+
;	Both devices are busy, or idle, so now we will scan to select which
; has the highest chance of completing fast ...
;
;	If the device supports seek optimization, convert the LBN
; into device specific parameters for the scan ...
;-
3555$:	.IF	DF,S$$OPT	; seek optimization support?

	BIT	#S2.OPT,S.ST2(R4)	; seek optimization supported?
	BEQ	356$		; if EQ, toggle between devices

	BIT	#S2.OPT,S.ST2(R0)	; does the secondary?
	BEQ	356$		; if EQ, toggle between devices
;+
; Convert the LBN into device dependent parameters, and determine
;	if one device is closer than the other, optimization wise ...
;
;    Since the device check routine calls $BLKCK, we cannot save
; any parameters on the stack at this point ...
;
;    Note: This routine will only work correctly if the device is
; utilizing the "nearest" form of seek optimization, and will be
; verified as such ...
;-
	MOV	S.ST2(R0),-(SP)	; get the optimization mode of secondary
	BIS	S.ST2(R4),(SP)	; and or in the primary opt mode
	BIT	#<S2.OP1!S2.OP2>,(SP)+	; both using nearest mode?
	BNE	356$		; if NE, nope, use toggle method

	MOV	(R5),R2		; get the DCB address of the primary
	MOV	D.DSP(R2),R2	; Get address of driver dispatch table
	CALL	@D.VCHK(R2)	; Call driver for block check and cvt

	INC	(R1)		; flag LBN translated in I.LNK

	MOV	R1,R3		; set up for $SHFND again ...
	CALL	$SHFND		; and locate our packets again ...
	MOV	I.UCB(R2),R3	; restore the other UCB address

	MOV	KISAR6,-(SP)	; save our APR6 mapping
	MOV	U.UCBX(R5),KISAR6	; map to the UCBX

	MOV	X.CCYL+140000,R0	; get our current cylinder
	SUB	I.PRM+10(R1),R0	; and form the delta cylinder count
	BGE	3556$		; if GE, forward direction ...

	NEG	R0		; create the absolute value ...

3556$:	MOV	U.UCBX(R3),KISAR6	; map to the secondary UCBX
	MOV	X.CCYL+140000,R4	; get their current cylinder
	SUB	I.PRM+10(R1),R4	; and form a delta cylinder count
	BGE	3557$		; if GE, forward direction ...

	NEG	R4		; create the absolute value ..

3557$:	MOV	(SP)+,KISAR6	; restore the previous APR6 mapping

	CMP	R0,R4		; which is closest?
	BLO	359$		; select the primary device
	BHI	357$		; select the secondary
;+
;  Toggle between devices ... everybody is the same distance
;-
	.ENDC	;DF,S$$OPT
356$:
	.IF	DF,M$$PRO	; mP support
;+
;   In an mP environment, we can also check if a particular KRB
; is available on the current CPU
;-
	MOV	U.SCB(R5),R0	; get the primary device SCB
	TSTB	S.STS(R0)	; is this SCB busy?
	BNE	3569$		; if NE, yes, don't check here ...

	CALL	3565$		; check if a port is on this CPU
	BCC	359$		; if CC, the primary is available here

	MOV	U.SCB(R3),R0	; and the secondary device SCB
	CALL	3565$		; check if a port is available
	BCS	3569$		; if CS, go and alternate ...
	BR	357$		; continue with the secondary

3565$:	MOV	#S2.LDS!S2.MAD,-(SP)	; set the status or multiport
	MOV	S.KRB(R0),R4	; get our current KRB

	BIC	S.ST2(R0),(SP)+	; are both bits set?
	BNE	3567$		; if NE, then both are not set

	ADD	#S.KTB,R0	; adjust to the KTB address
3566$:	MOV	(R0)+,R4	; get a port entry
	BEQ	3568$		; if EQ, end of the table, complain ...

	BIT	#KP.OFL,R4	; if this port offline?
	BNE	3566$		; if NE, yes, try next port

	CALL	3567$		; check this KRB

	BCS	3566$		; if CS, not this port
	RETURN			; to caller

3567$:	BIT	@$CPURM,K.URM(R4)	; is this on our CPU?
	BEQ	3568$		; report the error

	TSTB	K.IOC(R4)	; is this controller busy?
	BNE	3568$		; if NE, no gain here ...

	TST	(PC)+		; skip the next instruction
3568$:	SEC			; set carry
	RETURN			; to caller

3569$:
	.ENDC	;DF,M$$PRO	; mP support

	ASSUME	M.FLG-1,M.STS	; assume flag byte is high byte
	ASSUME	MF.LDS,200	; assume sign bit

	MOV	U.UMB(R5),R4	; get back the UMB address
	MOV	#MF.LDS*256.,R0	; set up our XOR mask
	XOR	R0,M.STS(R4)	; set up a polarity ...
	BMI	359$		; if MI, use primary device
;+
;   Use the secondary device ... Update packets, UCB's, and drivers ...
;-
357$:	MOV	(R1),(R2)	; propogate the translate flag
	BEQ	358$		; if EQ, LBN not translated ...

	MOV	I.PRM+10(R2),R4			; save the high order portion
	MOV	I.PRM+10(R1),I.PRM+10(R2)	; propogate the info
	MOV	R4,I.PRM+10(R1)			; and update the high LBN info

	MOV	I.PRM+12(R2),R4			; save the low order portion
	MOV	I.PRM+12(R1),I.PRM+12(R2)	; propogate the info
	MOV	R4,I.PRM+12(R1)			; and update the low LBN info

358$:	CLR	(R1)		; and flag as not adjusted

	MOV	R2,R1		; select the secondary packet ...
	MOV	R3,R5		; and a new UCB address
	MOV	(R5),R2		; get the DCB address

	MOV	D.PCB(R2),R3	; get the PCB address
	BEQ	359$		; if EQ, resident driver

	MOV	P.REL(R3),KINAR5	; map driver into APR5

	.IF	DF,K$$DAS	; Kernel D-space
	MOV	P.REL(R3),KDSAR5	; and map into D-space
	.ENDC	;DF,K$$DAS

359$:	MOV	U.SCB(R5),R4	; restore the SCB address
	MOV	(R5),R2		; insure we have the DCB address in R2

360$:	TST	(R1)		; need to translate LBN's?
	BNE	30$		; nope, skip the call ...

	.ENDC	;DF,S$$HDW&S$$HLS

	BIT	#S2.OPT,S.ST2(R4)  ;SEEK OPTIMIZATION SUPPORTED?
	BEQ	30$		;IF EQ NO
	MOV	D.DSP(R2),R2	;GET ADDRESS OF DRIVER DISPATCH TABLE
	CALL	@D.VCHK(R2)	;CALL DRIVER FOR BLOCK CHECK AND CVT
30$:	BITB	#UC.QUE,U.CTL(R5)  ;QUEUE PACKET BEFORE CALL?
	BNE	40$		;IF NE NO
	MOV	R4,R0		;SET ADDRESS OF I/O QUEUE LISTHEAD
	CALL	$QINSP		;QUEUE I/O PACKET IN DEVICE QUEUE
40$:	MOV	(R5),R2		;GET ADDRESS OF DEVICE CONTROL BLOCK
;+
;	** W A R N I N G **
;
;	SPM HOOKPOINT NUMBER 16.
;
;	DO NOT CHANGE THE INSTRUCTION FOLLOWING
;	LABEL WITHOUT CHECKING SPM
;-

$SPH16==.			;SPM CHANGES THE INSTRUCTION AT
				;THE LOCATION OF THIS LABEL

	MOV	D.DSP(R2),R2	;GET ADDRESS OF DRIVER DISPATCH TABLE

	CALL	@D.VINI(R2)	;CALL DRIVER INITIATOR
$QOPDN::			;$BLKC2 RETURNS HERE AFTER AN ERROR

	.IFT

	MOV	(SP)+,KDSAR5	;RESTORE KERNEL DATA APR5

	.ENDC


	MOV	(SP)+,KINAR5	;RESTORE KERNEL INSTRUCTION APR5
	RETURN			;


$DRWFA::MOV	#$DRWFS,-(SP)	;POINT TO WAIT FOR SINGLE FLAG ROUTINE

;+
;**-$MPDC1-MAP TO AND CALL DIRECTIVE COMMON
;
; THIS ROUTINE IS CALLED TO TRANSFER CONTROL TO A ROUTINE IN THE FIRST
; DIRECTIVE COMMON, THEN RESTORE THE CURRENT MAPPING AND RETURN TO THE
; CALLER.
;
; INPUTS:
;
;	 (SP) = RETURN ADDRES AFTER CALL
;	2(SP) = ROUTINE ADDRESS TO CALL
;
; OUTPUTS:
;
;	NONE.
;
; REGISTERS AND C-BIT ARE PRESERVED ACROSS CALL
;
;-
	.ENABL	LSB

$MPDC3::

	.IF DF	D$$PAR

	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE CURRENT D SPACE MAPPING
	$$$=4

	.IFF	; DF K$$DAS

	$$$=2

	.IFTF	; DF K$$DAS

	MOV	$$$(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	$$$(SP),$$$+2(SP) ;PUT RETURN ADDRESS IN RIGHT PLACE
	MOV	KINAR5,$$$(SP)	;SAVE CURRENT APR5 MAPPING


	MOV	$DRAP3,KINAR5	;MAP 2ND DIRECTIVE COMMON

	.IFT	; DF K$$DAS

	MOV	$DRAP3,KDSAR5	;MAP IT IN DATA SPACE AS WELL

	.ENDC	; DF K$$DAS

	BR	10$		;FINISH IN COMMON WITH MAP FIRST COMMON

	.IFTF	; DF D$$PAR

$MPDC4::

	.IFT	; DF D$$PAR

	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE CURRENT D SPACE MAPPING
	$$$=4

	.IFF	; DF K$$DAS

	$$$=2

	.IFTF	; DF K$$DAS

	MOV	$$$(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	$$$(SP),$$$+2(SP) ;PUT RETURN ADDRESS IN RIGHT PLACE
	MOV	KINAR5,$$$(SP)	;SAVE CURRENT APR5 MAPPING


	MOV	$DRAP4,KINAR5	;MAP 2ND DIRECTIVE COMMON

	.IFT	; DF K$$DAS

	MOV	$DRAP4,KDSAR5	;MAP IT IN DATA SPACE AS WELL

	.ENDC	; DF K$$DAS

	BR	10$		;FINISH IN COMMON WITH MAP FIRST COMMON

	.IFTF	; DF D$$PAR

$MPDC2::

	.IFT	; DF D$$PAR

	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE CURRENT D SPACE MAPPING
	$$$=4

	.IFF	; DF K$$DAS

	$$$=2

	.ENDC	; DF K$$DAS

	MOV	$$$(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	$$$(SP),$$$+2(SP) ;PUT RETURN ADDRESS IN RIGHT PLACE
	MOV	KINAR5,$$$(SP)	;SAVE CURRENT APR5 MAPPING


	MOV	$DRAP2,KINAR5	;MAP 2ND DIRECTIVE COMMON
	BR	10$		;FINISH IN COMMON WITH MAP FIRST COMMON

	.IFTF	; DF D$$PAR

$MPDCV::

	.IFT	; DF D$$PAR

	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE CURRENT D SPACE MAPPING
	$$$=4

	.IFF	; DF K$$DAS

	$$$=2

	.ENDC	; DF K$$DAS

	MOV	$$$(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	$$$(SP),$$$+2(SP) ;PUT RETURN ADDRESS IN RIGHT PLACE
	MOV	KINAR5,$$$(SP)	;SAVE CURRENT APR5 MAPPING


	MOV	$DRAPV,KINAR5	;MAP 2ND DIRECTIVE COMMON
	BR	10$		;FINISH IN COMMON WITH MAP FIRST COMMON

	.IFTF	; DF D$$PAR

$MPDC1::

	.IFT	; DF D$$PAR


	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE CURRENT D SPACE APR 5 MAPPING

	.ENDC	; DF K$$DAS

	MOV	$$$(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	$$$(SP),$$$+2(SP) ;PUT RETURN ADDRESS IN RIGHT PLACE
	MOV	KINAR5,$$$(SP)	;SAVE CURRENT APR5 MAPPING
	MOV	$DRAPR,KINAR5	;MAP TO DIRECTIVE COMMON
10$:	CALL	@(SP)+		;CALL DESIRED ROUTINE


	.IF DF	K$$DAS

	MOV	(SP)+,KDSAR5	;RESTORE PREVIOUS D SPACE APR 5 MAPPING

	.ENDC	; DF K$$DAS


	MOV	(SP)+,KINAR5	;RESTORE PREVIOUS MAPPING
	RETURN			;

	.IFF	; DF D$$PAR

	CALLR	@(SP)+		;DIRECT TRANSFER TO ROUTINE

	.ENDC	; DF D$$PAR

	.DSABL	LSB


;+
; **-$CPXXX- STUB ROUTINES FOR CPRSX
;-
;	THIS MODULE PROVIDES GLOBAL ENTRY POINTS TO MAP AND CALL
;	ROUTINES IN THE CPRSX COMMUNICATION DRIVER.
;

	.ENABL	LSB

$CPCON::
	.IF DF C$$RMT		;IF REMOTE SYSTEM SERVICES

	MOV	#CPRCON,R3	;SAVE OUR CALLING ADDRESS
	BR	10$		;JOIN COMMON CODE

	.IFTF			;C$$RMT
$CPALO::
	.IFT			;C$$RMT

	MOV	#CPRALO,R3	;SAVE OUR CALLING ADDRESS
	BR	10$		;JOIN COMMON CODE

	.IFTF			;C$$RMT
$CPDEA::
	.IFT			;C$$RMT

	MOV	#CPRDEA,R3	;SAVE OUR CALLING ADDRESS
	BR	10$		;JOIN COMMON CODE

	.IFTF			;C$$RMT
$CPRCV::
	.IFT			;C$$RMT

	MOV	#CPRRCV,R3	;SAVE OUR CALLING ADDRESS
	BR	10$		;JOIN COMMON CODE

	.IFTF			;C$$RMT
$CPABO::
	.IFT			;C$$RMT

	MOV	#CPRABO,R3	;SAVE OUR CALLING ADDRESS
	BR	10$		;JOIN COMMON CODE

	.IFTF			;C$$RMT
$CPSEN::
	.IFT			;C$$RMT

	MOV	#CPRSEN,R3	;SAVE OUR CALLING ADDRESS
10$:
	MOV	@#KINAR5,-(SP)	;SAVE APR5 I SPACE MAPPING
	MOV	@#KISAR5,-(SP)	;SAVE APR5 D SPACE MAPPING
	MOV	$KXBAS,@#KISAR5	;MAP THE DRIVER
	MOV	$KXBAS,@#KINAR5	;MAP THE DRIVER
	CALL	@(R3)		;CALL THE ROUTINE
	MOV	(SP)+,@#KISAR5	;RESTORE APR5 D SPACE MAPPING
	MOV	(SP)+,@#KINAR5	;RESTORE APR5 I SPACE MAPPING

	.ENDC			;C$$RMT

	RETURN

	.DSABL	LSB

;$IMASG - IMPLICIT ASSIGN LUN CALL
;
; THIS ROUTINE IS USED BY QIO, GLUN, GDVI ETC. TO JUMP TO ALUN FROM THE OTHER
; DIRECTIVE COMMONS FOR RUN TIME BINDING
;
$IMASG::

	.IF DF C$$RTB		;RUN TIME BINDING SUPPORT

	MOV	$DRAPR,KINAR5	;MAP TO FIRST COMMON
	MOV	$DRAPR,KDSAR5	;MAP IN D-SPACE ALSO

	JMP	$IMAS1		;JUMP TO ROUTINE IN DRASG

	.ENDC	; C$$RTB

;+
; **-$MPPRO- MAP AND CALL SPECIFIED PROCESS THEN RETURN TO CALLER
;
; THIS ROUTINE IS CALLED TO MAP AND CALL THE ROUTINE INDICATED BY THE
; ADDRESS DOUBLE WORD ON THE STACK.  MAPPING IS DONE VIA APR5.
;
; INPUTS:
;
;	 (SP) = RETURN ADDRESS AFTER CALL
;	2(SP) = ROUTINE ADDRESS TO CALL
;	4(SP) = MAPPING OF ROUTINE TO CALL
;
; OUTPUTS:
;
;	NONE.
;
;	ALL REGISTERS ARE PRESERVED.
;-


$MPPRO::
	MOV	2(SP),-(SP)	;COPY ADDRESS OF ROUTINE
	MOV	KISAR5, 4(SP)	;COPY APR5 BIAS
	MOV	6(SP),KISAR5	;MAP ROUTINE TO BE CALLED
	MOV	2(SP), 6(SP)	;COPY RETURN ADDRESS

	.IF	DF	K$$DAS

	MOV	KINAR5,2(SP)	;FOR I/D SYSTEMS SAVE KINAR5
	MOV	KISAR5, KINAR5	;AND MAP KINAR5

	.IFF	; DF K$$DAS

	MOV	(SP)+, (SP) 	;MOVE ADDRESS OF ROUTINE

	.IFTF

	CALL	@(SP)+		;TRANSFER CONTROL TO PROCESS

	.IFT	;DF K$$DAS

	MOV	(SP)+,KINAR5	;RESTORE MAPPING

	.ENDC	; DF K$$DAS

	MOV	(SP)+,KISAR5	;RESTORE MAPPING
	RETURN			;TRANSFER CONTROL BACK TO CALLER


;+
; **-$FNCLI-FIND CPB FOR SPECIFIED CLI
;
; THIS ROUTINE LOCATES THE CPB FOR THE SPECIFIED CLI
;
; INPUTS:
;
;	R3=ADDRESS OF CLI NAME STORED IN RAD50
;
; OUTPUTS:
;
;	C=1 CLI DOES NOT EXIST
;	C=0 CLI SUCCESSFULLY FOUND
;		R1=OFFSET TO ENTRY FOR CLI IN $CPTBL
;		R4=CPB ADDRESS
;
; REGISTERS R0, R2 AND R3 ARE PRESERVED ACROSS CALL
;
;-

	.IF DF	A$$CLI

$FNCLI::MOV	#$NMCLI!40000,-(SP) ;GET NUMBER OF CLIS SYSTEM CAN SUPPORT
	CLR	R1		;START AT BEGINNING OF TABLE
10$:	MOV	$CPTBL(R1),R4	;POINT TO NEXT CPB
	BEQ	20$		;IF EQ, EMPTY SLOT
	CMP	C.PNAM(R4),(R3)	;IS THIS THE CLI
	BNE	20$		;IF NE NO
	CMP	C.PNAM+2(R4),2(R3) ;MAYBE
	BEQ	30$		;IF EQ YES
20$:	TST	(R1)+		;SET OFFSET FOR NEXT SLOT IN TABLE
	DECB	(SP)		;IS THERE A SLOT LEFT
	BGT	10$		;IF GT YES
	ASL	(SP)		;PUT BIT IN POSITION TO SET CARRY
30$:	ASL	(SP)+		;POP STACK AND SET APPROPRIATE CARRY
	RETURN

	.IFF	;A$$CLI

$FNCLI::MOV	#$MCRPT,R4	;POINT TO MCR'S CPB, ONLY ONE IN SYSTEM
	CLR	R1		;OFFSET TO MCR'S SLOT IN $CPTBL
	CMP	C.PNAM(R4),(R3)	;LOOKING FOR MCR
	BNE	10$		;IF NE NO
	TST	2(R3)		;MATCH MUST BE EXACT
	BEQ	20$		;IF EQ, OK
10$:	SEC			;NOT LOOKING FOR MCR
20$:	RETURN

$STCLI==-1			;DEFINE SYMBOL FOR MCR

;+
; **-$STCLI-SET CLI
;
; THIS ENTRY POINT EXISTS SO ROUTINES OUTSIDE THE EXECUTIVE CAN
; CALL THE ROUTINE TO SET A TERMINALS CLI ON SYSTEMS THAT SUPPORT
; THE DIRECTIVE COMMON. THE ROUTINE ITSELF RESIDES IN THE DRCLI
; MODULE. CHECK THERE FOR ALL DETAILS.
;
;-

	.IFT	;A$$CLI


	.IF DF	D$$PAR

$STCLI::MOV	#$STCL1,-(SP)	;GET ADDRESS OF ALT ENTRY IN COMMON
;
; R3 POINTS TO THE NAME OF THE CLI THAT THE TERMINAL IS TO BE SET
; TO. IF A TASK IS CALLING $STCLI, THE NAME COULD BE IN TASK SPACE
; THAT WILL BE UNMAPPED WHEN THE DIRECTIVE COMMON IS MAPPED.
; THEREFORE, $FNCLI MUST BE CALLED BEFORE THE MAPPING IS CHANGED.
; NOTE: $MPCM2 MUST PRESERVE ALL REGISTERS AND THE C BIT.
;
	CALL	$FNCLI		;FIND THE SPECIFIED CLI
	CALL	$MPDC2		;MAP AND CALL ROUTINE
	RETURN			;

	.ENDC	;D$$PAR


	.ENDC	;A$$CLI


;+
; **-$SNCMD-SEND NEXT COMMAND TO CLI DISPATCHER
;
; THIS ROUTINE IS CALLED UPON COMPLETION OF THE EXECUTION OF A
; CLI COMMAND, WHEN THE TI: TERMINAL HAS SERIAL COMMAND EXECUTION
; ENABLED. IT CALLS THE TTDRV AT THE APPROPRIATE ENTRY POINT TO
; CAUSE IT TO FIND THE NEXT COMMAND IN THE TYPEAHEAD BUFFER AND SEND
; IT TO MCR... TO START EXECUTION.
;
; INPUTS:
;
;	R0=UCB ADDRESS OF TI: TERMINAL
;
; OUTPUTS:
;
;	NONE
;
;-

$SNCMD::

	.IF NDF	R$$PRO		;NO SERIAL COMMAND MORE FOR P/OS

	BIT	#DV.PSE,U.CW1(R0) ;IS TI: A PSEUDO DEVICE?
	BNE	10$		;IF NE, EXIT
	BIT	#UM.SER,U.MUP(R0) ;TERMINAL IN SERIAL COMMAND MODE?
	BEQ	10$		;IF EQ NO
	MOV	(R0),R2		;POINT TO DCB
	MOV	KINAR5,-(SP)	;SAVE CURRENT MAPPING
	MOV	KINAR6,-(SP)	;...


	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	;SAVE DATA SPACE MAPPING
	MOV	KDSAR6,-(SP)	;...

	.IFTF

	MOV	D.PCB(R2),R3	;POINT TO PCB FOR TTDRV
	MOV	P.REL(R3),KINAR5 ;MAP DRIVER

	.IFT

	MOV	P.REL(R3),KDSAR5 ;MAP DRIVER IN D SPACE

	.IFTF

	MOV	D.DSP(R2),R2	;POINT TO DISPATCH TABLE
	CALL	@D.VNXC(R2)	;CALL TTDRV TO SEND NEXT COMMAND

	.IFT

	MOV	(SP)+,KDSAR6	;RESTORE DATA SPACE MAPPING
	MOV	(SP)+,KDSAR5	;RESTORE DATA SPACE MAPPING

	.ENDC


	MOV	(SP)+,KINAR6	;RESTORE INSTRUCTION SPACE MAPPING
	MOV	(SP)+,KINAR5	;RESTORE INSTRUCTION SPACE MAPPING

	.ENDC	;R$$PRO

10$:	RETURN

; THIS MODULE CONTAINS ROUTINES WHICH MUST BE REMOVED FROM OTHER
; DIRECTIVE MODULES SINCE THEY CAN NOT BE PLACED IN THE DIRECTIVE
; COMMON



	.IF DF G$$GEF
;+
; **-$ELGEF-SUBROUTINE TO ELIMINATE A GROUP GLOBAL EVENT FLAG BLOCK
;
; THIS SUBROUTINE UNCONDITIONALLY UNLINKS A GROUP GLOBAL EVENT FLAG BLOCK
; AND DEALLOCATES IT.
;
; INPUTS:
;
;	R0=ADDRESS OF BLOCK POINTING TO BLOCK TO BE DEALLOCATED
;	R1=ADDRESS OF BLOCK TO BE ELIMINATED
;
; OUTPUTS:
;
;	NONE.
;-

$ELGEF::MOV	(R1),(R0)	;UNLINK THE BLOCK
	MOV	R1,R0		;SET UP TO DEALLOCATE THE BLOCK
	MOV	#10.,R1		;
	CALLR	$DEACB		;DEALLOCATE THE BLOCK

;+
; **-$DEAGF-DEACCESS GROUP GLOBAL EVENT FLAGS
;
; THIS ROUTINE DETERMINES IF GROUP GLOBAL EVENT FLAGS EXIST FOR A TASK.
; IF THEY DO, THE ACCESS COUNT IN THE GROUP
; GLOBAL EVENT FLAG BLOCK IS DECREMENTED AND THE BLOCK IS DEALLOCATED
; IF IT IS MARKED FOR DELETE.
;
; INPUTS:
;
;	R3=EVENT FLAG MASK ADDRESS
;	R4=TASK HEADER ADDRESS
;	R5=TASK TCB ADDRESS.
;
; OUTPUTS:
;
;	NONE.
;
;-

$DEAGF::SAVNR			;SAVE NON-VOLATILE REGISTERS
	MOVB	H.CUIC+1(R4),R4	;GET GROUP NUMBER
	CALL	$SRGEF		;SEARCH FOR GROUP GLOBAL EVENT FLAGS
	BCS	10$		;IF CS NOT FOUND
	BIC	#1,R3		;CLEAR GROUP GLOBAL 2ND WORD INDICATOR
	CMP	R3,R1		;GROUP GLOBAL EVENT FLAG ?
	BLO	10$		;IF LO NO
	SUB	#G.LGTH,R3	;POINT TO BEGINNING OF BLOCK
	CMP	R3,R1		;GROUP GLOBAL EVENT FLAG ?
	BHIS	10$		;IF HIS NO
	DECB	T.GGF(R5)	;DECR GRP GLOBAL USE COUNT FOR TASK
	DEC	G.CNT(R1)	;DECREMENT ACCESS COUNT
	BNE	10$		;IF NE CAN'T ELIMINATE FLAGS YET
	BITB	#GS.DEL,G.STAT(R1) ;MARKED FOR DELETE ?
	BNE	$ELGEF		;IF NE YES, ELIMINATE FLAG GROUP
10$:	RETURN			;


	.ENDC	; DF G$$GEF

;+
;**-$CLEDI-CALL USERS ENABLE DISABLE INTERRUPTS ROUTINE
;
; THIS ROUTINE IS CALLED FROM THE CINT$ DIRECTIVE TO MAP THE USERS
; ENABLE/DISABLE INTERRUPTS ROUTINE AND CALL IT.
;
; INPUTS:
;
;	R1=ITB ADDRESS
;	C=0 TO ENABLE INTERRUPTS
;	C=1 TO DISABLE
;
; OUTPUTS:
;
;	NONE.
;-

$CLEDR::MOV	X.DSI(R1),R2	; GET ADDRESS OF USER ROUTINE TO
				; ENABLE/DISABLE INTERRUPTS
	BEQ	10$		; NONE - EXIT
	MOV	KINAR5,-(SP)	; SAVE CURRENT MAPPING OF APR5
	MOV	X.REL(R1),KINAR5 ; MAP ROUTINE IN KERNEL APR 5

	.IF DF	K$$DAS

	MOV	KDSAR5,-(SP)	; SAVE D SPACE APR 5 TOO
	MOV	X.REL(R1),KDSAR5 ; MAP IN DATA SPACE APR 5 TOO

	.ENDC

	CALL	@R2		; CALL ROUTINE AND RETURN
				; R1 = POINTER TO ITB
				; CC-C = 0 TO ENABLE INTERRUPTS,
				;      = 1 TO DISABLE INTERRUPTS

	.IF DF	K$$DAS

	MOV	(SP)+,KDSAR5	; RESTORE D SPACE APR 5 MAPPING

	.ENDC	; DF K$$DAS

	MOV	(SP)+,KINAR5	; RESTORE APR5 MAPPING
10$:	RETURN			; EXIT

;+
;**-$DRGLI-GET LUN INFORMANTION
;**-$DRGIN-GET INFORMATION
;**-$DREXP-EXTEND PARTITION
;**-$DRGCL-GET COMMAND LINE
;
; THESE ARE THE TRANSFER STUBS TO MAP THE VECTOR COMMON FOR THESE DIRECTIVES.
; TWO THINGS ARE IMPORTANT TO NOTE:
;
;	1) THE DRTBL TABLES MARK THE DIRECTIVES AS BEING IN THE SECOND
;	   COMMON SO THAT SAVE AND RESTORE OF THE FIRST COMMONS MAPPING
;	   OCCURS (OTHERWISE RETURN TO THE DISPATHCER IS IMPOSSIBLE).
;
;	2) SINCE THESE STUB ROUTINES USE R1, ALL THE DIRECTIVES IN THE
;	   VETOR COMMON MUST NOT USE R1 AS AN INPUT.
;-
	.ENABL	LSB

$DREXP::MOV	#$DRXP1,R1	; GET ADDRESS OF REAL ROUTINE
	BR	10$		; FINISH IN COMMON CODE

$DRGCL::MOV	#$DRGC1,R1	; GET ADDRESS OF REAL ROUTINE
	BR	10$		; FINISH IN COMMON CODE

$DRGIN::MOV	#$DRGN1,R1	; GET ADDRESS OF REAL ROUTINE
	BR	10$		; FINISH IN COMMON CODE

$DRGLI::MOV	#$DRGL1,R1	; GET ADDRESS OF REAL ROUTINE
	BR	10$		; FINISH IN COMMON CODE

10$:	MOV	$DRAPV,KINAR5	; MAP TO VECTOR COMMON IN I SPACE

	.IF DF	K$$DAS

	MOV	$DRAPV,KDSAR5	; MAP TO VECTOR COMMON IN D SPACE

	.ENDC	; DF K$$DAS

	JMP	(R1)		; TO PROCESSING ROUTINE

	.DSABL	LSB

;+
;**-$DRLOG-LOGICAL NAME TRANSLATION DIRECTIVES
;
; THIS ENTRY POINT MAPS THE FOURHT COMMON AND TRANSFERS TO THE
; LOGICAL NAME ROUTINES. SEE MODULE DRLOG FOR DETAILS ON THE OPERATION.
;
;-

$DRLOG::

	.IF DF	L$$GCL!N$$DIR

	.IF DF	D$$PAR

	MOV	$DRAP3,KINAR5	; MAP THIRD COMMON (I-SPACE)

	.IF DF	K$$DAS

	MOV	$DRAP3,KDSAR5	; MAP THIRD COMMON (D-SPACE)

	.ENDC	; DF K$$DAS

	.ENDC	; DF D$$PAR

	JMP	$DRLG1		; JUMP TO VECTOR COMMON

	.ENDC	; DF L$$GCL!N$$DIR

	.IF DF	L$$GCL

	.ENABL	LSB
;+
;**-$DELO1-ROUTINE STUB FILE FOR FOURTH DIRECTIVE COMMON ROUTINE $DELOG
;
; THIS ENTRY POINT MAPS THE FOURTH COMMON AND TRANSFERS TO THE
; ROUTINE $DELOG.
;
;-
	.IFTF	; DF L$$GCL

$DELO1::

	.IFT	; DF L$$GCL

	MOV	#$DELOG,-(SP)	;GET ADDRESS OF ROUTINE IN 4TH DIRCOM
	BR	10$		;JOIN COMMON CODE

;+
;**-$CRLO1-ROUTINE STUB FILE FOR FOURTH DIRECTIVE COMMON ROUTINE $CRLOG
;
; THIS ENTRY POINT MAPS THE FOURTH COMMON AND TRANSFERS TO THE
; ROUTINE $CRLOG.
;
;-
	.IFTF	; DF L$$GCL

$CRLO1::

	.IFT	; DF L$$GCL

	MOV	#$CRLOG,-(SP)	;GET ADDRESS OF ROUTINE IN DIRECTIVE COMMON
	BR	10$		;JUMP TO COMMON CODE

;+
;**-$LNTD1-ROUTINE STUB FILE FOR FOURTH DIRECTIVE COMMON ROUTINE $LNTDR
;
; THIS ENTRY POINT MAPS THE FOURTH COMMON AND TRANSFERS TO THE
; ROUTINE $LNTDR.
;
;-
	.IFTF	; DF L$$GCL

$LNTD1::

	.IFT	; DF L$$GCL

	MOV	#$LNTDR,-(SP)	;GET ADDRESS OF ROUTINE IN DIRECTIVE COMMON
	BR	10$		;JOIN COMMON CODE

;+
;**-$RLRLN-ROUTINE STUB FILE FOR FOURTH DIRECTIVE COMMON ROUTINE $LNTDR
;
; THIS ENTRY POINT MAPS THE FOURTH COMMON AND TRANSFERS TO THE
; ROUTINE $RLRL1
;
;-
	.IFTF	; DF L$$GCL

$RLRLN::

	.IFT	; DF L$$GCL

	MOV	#$RTRL1,-(SP)	;GET ADDRESS OF ROUTINE IN DIRECTIVE COMMON
	BR	10$		;JOIN COMMON CODE


;+
; $TBTRN - ROUTINE TO TRANSLATE THE LOGICAL TABLE NUMBER INTO AN HASH TABLE
;	OFFSET AND THEN MAP THE HASH TABLE THROUGH KISAR6
;
; INPUTS:
;	R3 - TABLE NUMBER
; OUTPUTS:
;	CC - SUCCESS:
;		KISAR6 - CONTAINS MAPPING TO START OF HASH TABLE
;	CS - NO HASH TABLE VALUE AVAILABLE
;
; R3, KISAR6 ARE DESTROYED BY CALL
;
; THIS ROUTINE TAKES THE SPECIFIED LOGICAL TABLE NUMBER AND TURNS IT
; INTO A WORD OFFSET INTO THE HIERARCHY TABLE IN SYSCM.  THE HIERARCHY
; TABLE CONTAINS THE SECONDARY POOL POINTERS TO EACH OF THE HASH TABLES
; IN AN ORDERED, PRECEDENCE-DERIVED SEQUENCE.  SINCE THE TABLE NUMBERS
; NO LONGER HAVE ANY PRETENSE OF PRECEDENCE ORDERING, IT IS NECESSARY
; TO HASH THE VALUES INTO THE CORRECT WORD OFFSET.  FROM THIS OFFSET,
; THE APR BIAS OF THE HASH TABLE IS PLACED INTO KISAR6 SO THAT ANY
; 140000-140100 KERNEL DATA REFERENCES WILL ACCESS THE HASH TABLE.
;-
	.IFTF	;DF L$$GCL

$TBTRN::

	.IFT	;DF L$$GCL

	MOV	#$TBTRL,-(SP)
	BR	10$

;+
;**-$LDEL1-ROUTINE STUB FILE FOR FOURTH DIRECTIVE COMMON ROUTINE $LDELX
;
; THIS ENTRY POINT MAPS THE FOURTH COMMON AND TRANSFERS TO THE
; ROUTINE $LDELX.
;
;-
	.IFTF	; DF L$$GCL

$LDEL1::

	.IFT	; DF L$$GCL

	MOV	#$LDELX,-(SP)	; SET ADDRESS TO DIRECTIVE ROUTINE

10$:	CALL	$MPDC3		; MAP THE ROUTINE IN THE 3RD DIRECTIVE COMMON

	.IFF	; DF L$$GCL

	SEC

	.IFTF	; DF L$$GCL

	RETURN

	.DSABL	LSB

	.ENDC	; DF L$$GCL


	.IF DF P$$3XX

;+
; $FLIPM -- THIS ROUTINE COPIES A BUFFER AND INVERTS IT.
;
;	INPUTS:
;		R0 = APR 5 ADDRESS OF LAST WD. +2 OF SOURCE BUFFER
;		R1 = BIAS OF SOURCE BUFFER
;		R2 = NUMBER OF WORDS TO TRANSFER
;		R3 = APR6 ADDRESS OF TARGET USER BUFFER
;
;	OUTPUTS:
;
;		BUFFER IS TRANSFERRED
;		APR5 BIAS IS NOT RESTORED
;-
$FLIPM::
	MOV	R1,KISAR5	;SET UP APR5 BIAS OF SOURCE BUFFER
10$:	MOV	-(R0),(R3)+	;MOVE A WORD
	SOB	R2,10$		;LOOP TILL DONE
	RETURN

	.ENDC ; DF P$$3XX




	.MCALL	LNMDF$

	LNMDF$

	MAP5	=	120000
	MAP6	=	140000

	.IF DF 	N$$DIR
;+
; $DLCTX -- DELETE A SPECIFIED CONTEXT BLOCK
;
; INPUT:
;	R1 = ADDRESS OF THE CONTEXT BLOCK TO BE DELETED
;
; OUTPUT:
;	USE COUNT IN CONTEXT BLOCK IS DECREMENTED.  IF CONTEXT
;	BLOCK IS NOT USE BY SOMEONE ELSE, THE SPECIFIED CONTEXT
;	BLOCK IS DELETED
;
; *****  NOTE: IT IS THE RESPONSIBILTY OF THE CALLER TO ZERO THE
;	 POINTER TO THE CTX.
;
;
; REGISTER R1 DESTROYED.
;
; -
	.IFTF	;DF N$$DIR

$DLCTX::

	.IFT

	MOV	R0,-(SP)		;SAVE R0
	MOV	KISAR6,-(SP)		;SAVE CURRENT MAPPING
	MOV	R1,KISAR6		;MAP OLD CTX BLOCK
	BEQ	20$			;IF EQ, NO BLOCK TO DEALLOCATE
	CMPB	#1,C.REF+MAP6		;ONLY ONE REFERENCE?
	BEQ	10$			;YES, DEALLOCATE BLOCK
	DECB	C.REF+MAP6		;DECREMENT USE COUNT
	BR	20$			;

10$:	MOV	R1,R0			;OLD CONTEXT BLOCK BIAS
	CLR	R1			;
	BISB	C.DDSL+MAP6,R1		;GET SIZE OF DDS
	ADD	#C.FIXL+77,R1		;GET FIXED LENGTH PLUS MODULOS
	ASH	#-6,R1			;CONVERT INTO 32W BLOCKS
	MOV	R2,-(SP)		;SAVE R2
	CALL	$DESEC			;DEALLOCATE PACKET
	MOV	(SP)+,R2		;RESTORE R2
20$:	MOV	(SP)+,KISAR6		;RESTORE MAPPING
	MOV	(SP)+,R0		;RESTORE R0
	RETURN

;+
; $CRCTX -- CREATE A SPECIFIED CONTEXT BLOCK
;
;	R0 = SIZE OF USER BUFFER (IN BYTES)
;	R1 = BIAS OF USER BUFFER
;	R2 = APR5 DISPLACEMENT TO USER BUFFER
;
; OUTPUT:
;
; 	R3 = ADDRESS OF NEW CONTEXT BLOCK
;
; -

	.IFTF	;DF N$$DIR

$CRCTX::

	.IFT	;DF N$$DIR

	MOV	KISAR6,-(SP)		;SAVE CURRENT MAPPING
	MOV	R2,-(SP)		;SAVE DISPLACEMENT
	MOV	R1,-(SP)		;SAVE BIAS
	MOV	R0,-(SP)		;SAVE DDS SIZE
	MOV	R0,R1			;GET SIZE OF NEW DDS
	ADD	#C.FIXL+77,R1		;ADD FIXED SIZE + MODULUS
	ASH	#-6,R1			;CONVERT TO BLOCKS
	CALL	$ALSEC			;ALLOCATE BLOCK FOR DDS LNB
	BCS	50$			;IF CS, ALLOCATION FAILURE
	MOV	R0,R3			;SET UP SEC. POOL BLK BIAS FOR COPY
	MOV	R3,KISAR6		;MAP BLOCK
	CLRB	C.REF+MAP6		;ZERO REFERENCE COUNT
	MOV	(SP)+,R0		;SET UP BYTE COUNT OF STRING TO COPY
	MOVB	R0,C.DDSL+MAP6		;FILL IN SIZE
	BEQ	10$			;IF EQ, ZERO LENGTH DDS
	MOVB	#1,C.REF+MAP6		;FILL IN REFERENCE COUNT
	MOV	(SP)+,R1		;SET UP BIAS
	MOV	(SP)+,R2		;SET UP DISPLACEMENT
	MOV	#C.DDS+MAP6,R4		;SETUP DISPLACEMENT TO STRING IN BLOCK
	CALL	$BLXIO			;COPY DDS
	BR	20$			;
10$:	CMP	(SP)+,(SP)+		;CLEAN STACK
20$:	MOV	(SP)+,KISAR6		;RESTORE MAPPING
	CLC				;INDICATE SUCCESS
	RETURN				;

50$:	CMP	(SP)+,(SP)+		;CLEAN STACK
	MOV	(SP)+,R2		;RESTORE R2
	MOV	(SP)+,KISAR6		;RESTORE MAPPING

	.IFTF	;DF N$$DIR

	SEC				;INDICATE FAILURE
	RETURN				;

	.ENDC	;DF N$$DIR


	.IF DF	L$$GCL

;+
; $CMPST -- THIS ROUTINE IS USED TO COMPARE A USER SPECIFIED STRING
;	    AGAINST A CURRENTLY MAPPED LOGICAL NAME BLOCK.
;
;	INPUTS:
;	R0 - POINTER TO LOGICAL NAME DESCRIPTOR BLOCK
;		BLOCK CONTAINS:
;			WD 1 - BYTE COUNT OF LOGICAL NAME
;			WD 2 - 32 WD BLOCK ADDRESS OF LOGICAL NAME
;			WD 3 - APR6 BIASED OFFSET TO START OF LOGICAL NAME
;			WD 4 - TABLE # TO BE SEARCHED (LOW BYTE)
;			       BLOCK TYPE NUMBER (HIGH BYTE)
;			WD 5 - MATCHING TCB OR UCB DEPENDING ON TYPE OF TABLE
;
;		THE LOGICAL NAME STRING TO BE COMPARED AGAINST IS MAPPED
;		THROUGH APR6.  THIS ROUTINE IS ONLY TO BE USED WHEN IT IS
;		KNOWN THAT THE LENGTHS OF THE TWO STRINGS TO BE CHECKED ARE
;		THE SAME.
;
;	OUTPUT:
;
;		C=0 AND R1 = 0	MATCH
;		C=0 AND R1 <>0  NO MATCH BUT TRY NEXT
;		C=1		NO MATCH AND EITHER INSERT ON PREVIOUS
;				OR STOP ANY FURTHER SEARCH
;
;		R2,R3 ARE PRESERVED
;
;-
$CMPST::MOV	KISAR5,-(SP)		;SAVE CURRENT APR5 MAPPING
	MOV	R2,-(SP)		;SAVE R2
	MOV	R3,-(SP)		;SAVE R3
	MOV	(R0),R1			;GET LENGTH OF STRINGS TO VERIFY
	MOV	4(R0),R3		;GET APR6 OFFSET TO USER BUFFER
	MOV	2(R0),KISAR5		;MAP USER LNS
	SUB	#20000,R3		;REDUCE IT TO AN APR5 OFFSET
	MOV	#L.NNAM+140000,R2	;POINT AT LOGICAL NAME STRING
15$:	CALL	$CVBUC			;CONVERT NEXT USER CHAR TO UPPER CASE
	CMPB	R5,(R2)+		;COMPARE THE TWO STRINGS
	BLO	30$			;IF LO INPUT STRING SHOULD OCCUR FIRST
	BHI	30$			;IF HI INPUT STRING SHOULD OCCUR LATER
	SOB	R1,15$			;COMPARE ENTIRE STRING
30$:	MOV	(SP)+,R3		;RESTORE R3
	MOV	(SP)+,R2		;RESTORE R2
	MOV	(SP)+,KISAR5		;RESTORE KISAR5 MAPPING
	RETURN				;RETURN TO CALLER



;+
; $CVBUC - ROUTINE TO CONVERT A SPECIFIED CHARACTER TO UPPER CASE
;
; INPUTS:
;	R3 - POINTER TO NEXT CHARACTER TO DO TRANSLATION UPON
;
; OUTPUTS:
;	R3 - POINTS TO BYTE PAST CHARACTER PROCESSED
;	R5 - UPCASED CHARACTER VALUE
;-
$CVBUC::
	CLR	R5		;INITIALIZE THE RETURNED VALUE
	BISB	(R3)+,R5	;GET THE VALUE
	CMPB	R5,#141		;CHARACTER IN LOWER CASE RANGE?
	BLO	10$		;IF LO NO
	CMPB	R5,#172		;CHARACTER OUTSIDE LOWER CASE RANGE?
	BHI	10$		;IF HI YES
	BICB	#40,R5		;CONVERT TO UPPER CASE
10$:	RETURN


;+
; $GTUSR - ROUTINE TO TAKE A RAW UCB ADDRESS, WALK DOWN THE REDIRECT CHAIN
;	UNTIL A NON-PSEUDO DEVICE IS FOUND, AND THEN PLUG THE USER HASH
;	TABLE ADDRESS WITH THE SECONDARY POOL VALUE FOR THAT DEVICE
;
; INPUTS:
;	R1 - RAW UCB ADDRESS
;
; OUTPUTS:
;	R1 - UCB ADDRESS OF FIRST DEVICE IN REDIRECT CHAIN THAT IS NOT A
;		PSEUDO DEVICE
;	$USRLG - UPDATED TO HOLD THE U.LOG VALUE OF THE FOUND UCB
;
;-
	.IFTF	;DF L$$GCL
$GTUSR::
	BIT	#DV.PSE,U.CW1(R1)	;CHECK IF SPECIFIED UCB IS A PSEUDO
	BEQ	10$			;IF EQ, NO, GO AND PLUG $USRLG
	MOV	U.RED(R1),R1		;GET NEXT DEVICE IN REDIRECT CHAIN
	BR	$GTUSR			;GO BACK FOR CHECKS
10$:
	.IFT	;DF L$$GCL

	CLR	$USRLG			;INITIALIZE TO NO HASH TABLE

	.IFTF	;DF L$$GCL

	BIT	#DV.TTY,U.CW1(R1)	;IS THIS DEVICE A TERMINAL
	BEQ	20$			;IF EQ, NO, LEAVE NO HASH TABLE

	.IFT	;DF L$$GCL

	MOV	U.LOG(R1),$USRLG	;SET UP THE USER HASH TABLE ADDRESS

	.IFTF	;DF L$$GCL

20$:	RETURN


	.ENDC	;DF L$$GCL

	.IF DF	D$$PAR

;+
; **-$DREIF-EXIT IF
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO TERMINATE THE EXECUTION OF THE
; ISSUING TASK IF, AND ONLY IF, AN INDICATED EVENT FLAG IS CLEAR.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(53.),DPB SIZE(2.).
;	WD. 01 -- EVENT FLAG NUMBER OF EVENT FLAG THAT MUST BE CLEAR.
;
; INPUTS:
;
;	R0=EVENT FLAG MASK WORD.
;	R1=EVENT FLAG MASK ADDRESS.
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LAST WORD IN THE DPB+2.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF 'D.RS22' IS RETURNED IF THE SPECIFIED
;			EVENT FLAG IS SET.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS97' IF NO OR AN INVALID EVENT
;			FLAG NUMBER IS SPECIFIED.
;-

	.ENABL	LSB

$DREIF::BIT	R0,(R1)		;EVENT FLAG CLEAR?
	BEQ	$DREXT		;IF EQ YES
	DRSTS	D.RS22		;SET DIRECTIVE STATUS

;+
; **-$DREXT-EXIT
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO TERMINATE THE EXECUTION OF THE
; ISSUING TASK.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(51.),DPB SIZE(1.).
;
; INPUTS:
;
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LAST WORD IN THE DPB+2.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
;	NOTE: THIS DIRECTIVE IS ALSO CALLED FROM THE DISPATCHER AND
;		THEREFORE ONLY REQUIRES R5 TO BE LOADED ON ENTRANCE.
;
;	      PRIVILEGED TASKS WHICH DESIRE TO CALL $DREXT DIRECTLY
;		SHOULD SWITCH TO SYSTEM STATE AND IMMEDIATELY CALL $DREXT
;		WITHOUT CALLING ANY OTHER EXEC SUBROUTINES.
;		THIS IS BECAUSE OF POSSIBLE SIDE EFFECTS OF
;		OTHER EXEC ROUTINES (SUCH AS $TSKRP).
;
;		BECAUSE MANY PRIVILEGED TASKS CALL $DREXT, WE
;		WILL UNCONDITIONALLY MAP THE TASK HEADER SO THAT
;		THIS CODE DOES NOT HAVE TO BE ADDED ELSEWHERE.
;
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	NO STATUS IS RETURNED TO THE ISSUING TASK SINCE THIS DIRECTIVE
;	TERMINATES ITS EXECUTION.
;-

$DREXT::			;REFERENCE LABEL

	.IF DF	X$$HDR

	MOV	$SAHDB,KISAR6	;MAP CURRENT TASK HEADER

	.ENDC	; DF X$$HDR

	.IF DF	P$$OFF

	BIT	#T3.ACP,T.ST3(R5)    ;IS TASK AN ACP?
	BNE	$DREX1		     ;IF NE YES
	MOV	#EX$SUC,T.EFLG+2(R5) ;SET SUCCESSFUL EXIT STATUS
$DREX2::MOV	#S.CEXT,T.EFLG(R5)   ;SET SUCCESS CODE IN ABORT CODE

	.ENDC


$DREX1::MOV	$DRAPR,KINAR5	;MAP THE DIRECTIVE COMMON

	JMP	$DREX3		;AND GO THERE TO FINISH EXIT

	.PAGE

;+
; **-$TRTRP-TRAP TRAP
;
; THIS ROUTINE IS TRAPPED TO WHEN A TRAP INSTRUCTION IS EXECUTED. IF THE
; STACK DEPTH IS ZERO, THEN A DIRECTIVE STATUS IS TO BE RETURNED. ELSE
; CONTROL IS TRANSFERED TO THE EMT/TRAP SST HANDLING ROUTINE.
;
; INPUTS:
;
;	2(SP)=PS WORD PUSHED BY TRAP INSTRUCTION.
;	0(SP)=PC WORD PUSHED BY TRAP INSTRUCTION.
;
; OUTPUTS:
;
;	IF THE STACK DEPTH IS ZERO, THEN A DIRECTIVE STATUS IS RETURNED.
;	ELSE CONTROL IS TRANSFERED TO THE EMT/TRAP SST HANDLING ROUTINE.
;-

	.ENABL	LSB

$TRTRP::TST	$STKDP		;;;STACK DEPTH ZERO?
	BNE	$EMTRP		;;;IF NE NO
	MOV	(SP)+,R0	;;;GET ADDRESS + 2 OF TRAP INSTRUCTION
	MFPI	-(R0)		;;;PICK UP TRAP INSTRUCTION
	MOV	$DRAPR,KINAR5	;;;MAP TO DIRECTIVE COMMON (I SPACE)
	JMP	$TRTR1		;;;CONTINUE PROCESSING IN DIRECTIVE COMMON

;+
; **-$EMTRP-EMT TRAP
;
; THIS ROUTINE IS TRAPPED TO WHEN AN EMT INSTRUCTION IS EXECUTED. IF THE
; STACK DEPTH IS NOT +1, THEN THE SYSTEM IS CRASHED. ELSE A TEST IS
; MADE TO SEE IF THE EMT INSTRUCTION HAD A CODE OF 377. IF NOT, THEN
; CONTROL IS TRANSFERED TO THE EMT/TRAP SST HANDLING ROUTINE. ELSE THE
; APPROPRIATE DIRECTIVE IS EXECUTED.
;
; INPUTS:
;
;	2(SP)=PS WORD PUSHED BY EMT INSTRUCTION.
;	0(SP)=PC WORD PUSHED BY EMT INSTRUCTION.
;
; OUTPUTS:
;
;	IF THE STACK DEPTH IS NOT +1, THEN THE SYSTEM IS CRASHED. ELSE
;	CONTROL IS GIVEN TO THE EMT/TRAP SST ROUTINE OR A DIRECTIVE ROUTINE
;	DEPENDENT ON WHETHER THE EMT HAD A CODE OF 377.
;-

;
; DETERMINE IF LEGITIMATE ENTRY FROM USER STATE. IF NOT, CRASH
;

$EMTRP::TST	$STKDP		;;;ARE WE AT STACK DEPTH +1?
	BGT	2$		;;;IF GT YES
	JMP	$CREMT		;;;ELSE CRASH SYSTEM
2$:	DIRSV$			;;;SAVE REGISTERS AND SET PRIORITY
	MOV	$DRAPR,KINAR5	;MAP TO DIRECTIVE COMMON (I SPACE)
	JMP	$EMTR1		;;;CONTINUE PROCESSING IN DIRECTIVE COMMON

; ROUTINES USED BY DISPATCHER TO CALL OTHER COMMONS THAN FIRST

$DRCL2::MOV	$DRAP2,KINAR5	;MAP TO SECOND COMMON

	.IF DF	K$$DAS

	MOV	$DRAP2,KDSAR5	;MAP IN D-SPACE ALSO

	.ENDC	; DF K$$DAS

	CALL	@2(SP)		;CALL ROUTINE
	MOV	$DRAPR,KINAR5	;REMAP DISPATCHER IN I-SPACE
	MOV	(SP)+,(SP)	;COLLAPSE STACK
	RETURN			;AND BACK TO DISPATCHER

$DRCL3::MOV	$DRAP3,KINAR5	;MAP TO THIRD COMMON
	CALL	@2(SP)		;CALL ROUTINE
	MOV	$DRAPR,KINAR5	;REMAP DISPATCHER IN I-SPACE
	MOV	(SP)+,(SP)	;COLLAPSE STACK
	RETURN			;AND BACK TO DISPATCHER


$FINDR::MOV	$DRAPR,KINAR5	;REMAP DISPATCHER IN I-SPACE
	JMP	$DRFIN		;AND JUMP TO DISPATCHER COMPLETION

	.ENDC	; DF D$$PAR


	.END